Collection of Tools & Utilities/Collection of Tools and Utilities.iso/archiver/ziptv21.zip/INTRCOMM.INC

Text File | 1990-04-22 | 15KB | 597 lines

(*
 * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
 *
 * This is a component of the ProDoor System.
 * Do not distribute modified versions without my permission.
 * Do not remove or alter this notice or any other copyright notice.
 * If you use this in your own program you must distribute source code.
 * Do not use any of this in a commercial product.
 *
 *)

(*
 * intrcomm.inc - interrupt-based communication library for PCB ProDOOR
 *
 *)

{$R-,S-}


(* ------------------------------------------------------------ *)
procedure control_k;
   (* process cancel-output command *)
begin
   txque.next_in := 1;
   txque.next_out := 1;          (* throw away pending output *)
   txque.count := 0;

   rxque.next_in := 1;
   rxque.next_out := 1;          (* throw away pending input *)
   rxque.count := 0;

   linenum := 9000;              (* cancel current function *)
   pending_keys[0] := #0;
end;


(* ------------------------------------------------------------ *)
procedure INTR_service_MSR;
  (* modem status change interrupt *)
var
   c: byte;
begin
   c := port[ port_base+MSR ];
   io_delay;
end;


(* ------------------------------------------------------------ *)
procedure INTR_service_LSR;
   (* line status change interrupt *)
var
   c: byte;
begin
   c := port[ port_base+LSR ];
   io_delay;
end;


(* ------------------------------------------------------------ *)
procedure INTR_service_transmit;
   (* low-level interrupt service for transmit, call only when transmit
      holding register is empty *)
var
   c:       char;
const
   recur:  boolean = false;

begin

(* prevent recursion fb/bg *)
   if recur then exit;
   recur := true;

(* drop out if transmitter is busy *)
   if (port[ port_base+LSR ] and LSR_THRE) = 0 then
   begin
      io_delay;
      recur := false;
      exit;
   end;

   io_delay;

   (* stop transmitting when queue is empty, or XOFF is active
      or it is not CLEAR-to-send to modem *)

   xmit_active := (txque.count <> 0) and (not xoff_active) and
                  (disable_CTS_check or ((port[port_base+MSR] and MSR_CTS)>0));

   io_delay;

   (* start next byte transmitting *)
   if xmit_active then
   begin
      c := txque.data[txque.next_out];
      if txque.next_out < sizeof(txque.data) then
         inc(txque.next_out)
      else
         txque.next_out := 1;
      dec(txque.count);

      port[ port_base+THR ] := ord(c); io_delay;
   end;

   recur := false;
end;


(* ------------------------------------------------------------ *)
procedure INTR_service_receive;
   (* low-level interrupt service for receive data,
      call only when receive data is ready *)
var
   c: char;
   o: byte;
   err: boolean;

begin
   o := port[ port_base+LSR ];
   io_delay;

   err := false;
   if (o and LSR_OERR) <> 0 then begin inc(LOERR_count);  err := true; end;
   if (o and LSR_PERR) <> 0 then begin inc(LPERR_count);  err := true; end;
   if (o and LSR_FERR) <> 0 then begin inc(LFERR_count);  err := true; end;
   if (o and LSR_BREAK)<> 0 then begin inc(LBREAK_count); err := true; end;

   if err then
   begin
      o := port[ port_base+RBR ];
      exit;
   end;

   if ((o and LSR_DAV) = 0) then
      exit;

   c := chr( port[ port_base+RBR ] ); io_delay;

   if XOFF_active then           (* XOFF cancelled by any character *)
      cancel_xoff
   else

   if c = XOFF_char then         (* process XOFF/XON flow control *)
      XOFF_active := true
   else

   if (c = ^K) then              (* process cancel-output command *)
      control_k
   else

   if c = carrier_lost then      (* ignore this special character! *)
   begin
      {do nothing}
   end
   else

   if rxque.count < sizeof(rxque.data) then
   begin
      inc(rxque.count);
      rxque.data[rxque.next_in] := c;
      if rxque.next_in < sizeof(rxque.data) then
         inc(rxque.next_in)
      else
         rxque.next_in := 1;
   end;
end;


(* ------------------------------------------------------------ *)
procedure INTR_poll_transmit;
   (* recover from CTS or XOF handshake when needed *)
begin
   {no action if nothing to transmit}
   if (txque.count = 0) or (com_chan = 0) then
      exit;

   {check for XON if output suspended by XOFF}
   disable_int;
   INTR_service_receive;
   INTR_service_transmit;
   enable_int;
end;


(* ------------------------------------------------------------ *)
procedure cancel_xoff;
begin
   XOFF_active := false;
   INTR_poll_transmit;
end;


(* ------------------------------------------------------------ *)
procedure INTR_check_interrupts;
   (* check for and process any pending 8250 interrupts.
      can be called from TPAS *)
var
   status:  integer;

begin

(* get the interrupt identification register *)
   status := port[ port_base+IIR ]; io_delay;

(* repeatedly service interrupts until no more services possible *)
   while (status and IIR_PENDING) = 0 do
   begin
      {disable_int;}

      case (status and IIR_MASK) of
         IIR_MSR:   (* modem status change interrupt *)
            INTR_service_MSR;

         IIR_THRE:  (* transmit holding register empty interrupt *)
            INTR_service_transmit;

         IIR_DAV:   (* data available interrupt *)
            INTR_service_receive;

         IIR_LSR:   (* line status change interrupt *)
            INTR_service_MSR;
      end;

      {enable_int;}

  (* get the interrupt identification register again *)
      status := port[ port_base+IIR ];
      io_delay;
   end;

end;


(* ------------------------------------------------------------ *)
procedure INTR_interrupt_handler(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: word);
interrupt;
   (* low-level interrupt service routine.  this procedure processes
      all receive-ready and transmit-ready interrupts from the 8250 chip.
      DO NOT call this proc from TPAS *)

begin

(* service interrupts until no more services possible *)
   INTR_check_interrupts;

(* acknowledge the interrupt and return to foreground operation *)
   port[ $20 ] := $20;   {non-specific EOI} io_delay;

end;


(* ------------------------------------------------------------ *)
function INTR_receive_ready: boolean;
   (* see if any receive data is ready on the active com port *)
begin
   INTR_poll_transmit;
   INTR_receive_ready := rxque.count > 0;
end;


(* ------------------------------------------------------------ *)
procedure INTR_flush_com;
   (* wait for all pending transmit data to be sent *)
begin
   enable_int;
   while txque.count > 0 do
   begin
      INTR_poll_transmit;
      give_up_time;             (* give up extra time *)
   end;
end;


(* ------------------------------------------------------------ *)
procedure verify_txque_space;
   (* wait until there is enough space in the queue for this message *)
   (* or until flow control is released *)
begin
   while txque.count > queue_low_water do
   begin
      INTR_poll_transmit;
      give_up_time;             (* give up extra time *)
   end;
end;


(* ------------------------------------------------------------ *)
procedure INTR_lower_dtr;
   (* lower DTR to inhibit modem answering *)
var
   o: byte;
begin
   if (com_chan = 0) then exit;

   o := port [ port_base+MCR ];                 io_delay;
   port[ port_base+MCR ] := o and not MCR_DTR;  io_delay;
end;


(* ------------------------------------------------------------ *)
procedure INTR_raise_dtr;
   (* raise DTR to allow modem answering - not supported by BIOS *)
var
   o: byte;
begin
   if com_chan = 0 then exit;

   o := port [ port_base+MCR ];                       io_delay;
   port[ port_base+MCR ] := o or (MCR_DTR+MCR_RTS);   io_delay;
end;


(* ------------------------------------------------------------ *)
procedure INTR_select_port;
   (* lookup the port address for the specified com channel *)
begin
   xmit_active := false;
   XOFF_active := false;

   if (com_chan > 0) and (com_chan <= M